PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/tdmenu.com/TPPDMENU.PAS

Pascal/Delphi Source File | 1990-01-11 | 31.5 KB | 960 lines

{$S-,R-,V-,I-,B-,F-}

{$IFDEF Ver40}
  {$F-}
{$ELSE}
{$F+}
{$I OPLUS.INC}
{$ENDIF}

{$IFDEF Debug}
  {$D+}
{$ENDIF}

{Conditional defines that may affect this unit}
{$I TPDEFINE.INC}

{*********************************************************}
{*                  TPPDMENU.PAS 5.06                    *}
{*          Copyright (c) Ken Henderson 1989, 1990.      *}
{*                                                       *}
{*                                                       *}
{*                                                       *}
{*********************************************************}

unit TpPdmenu;
  {-Pulldown menu systems}

interface

uses
  TpCrt,                          {Turbo Professional CRT unit}
  Dos,                            {DOS interface - standard unit}
  {$IFDEF UseMouse}
  TpMouse,                        {Turbo Professional mouse routines}
  TpPdMous,                       {Mouse support for TpPdMenu}
  {$ENDIF}
  TpWindow,                       {Turbo Professional popup window management}
  TpString;                       {Turbo Professional string handling routines}

const
  MaxMenuDepth             = 3;   {Maximum depth of menus}
  MaxSelections            = 20;  {Maximum number of selections in one menu}
  Null                     = #0;
  OnOff                    : array[Boolean] of String[3] = ('ON ', 'OFF');

type
  ColorType =                     {Screen colors}
  (TextColor,                     {Normal menu color}
   FrameColor,                    {Menu frame color}
   SelectColor,                   {Selected menu item color}
   HighLightColor                 {Highlighted selection character in menu}
   );

  {Stores screen attributes}
  MenuAttributeArray       = array[ColorType] of Byte;

  {-Types to define user parameters}
  UserHelpType             = procedure(OptionIndex : Integer);
  UserValidationType       = function(OptionIndex : Integer) : Boolean;
  UserEvaluateType         = procedure(C : Integer; Stat : Byte; var S : String);

  {-Array to store menu data in, (size is arbitrary)}
  InitArray                = array[1..4096] of Byte;
  InitArrayPtr             = ^InitArray;

  {-Definitions for pulldown menu system}
  MenuOrientation          = (Horizontal, Vertical); {Horizontal or vertical scrolling menus}

  MenuDescriptor =
    record
      Orientation              : MenuOrientation; {Horizontal or vertical}
      Overlap                  : WindowPtr; {Points to buffer holding what it covers}
    end;

  Menulevels               = array[1..MaxMenuDepth] of MenuDescriptor;

  Menuptr                  = ^Menurecord;

  SubMenuRecord =                 {12 bytes}
    record
      Command                  : Integer; {Command returned via selection}
      Doffset                  : Byte; {Rows or cols offset for prompt within window}
      StatVal                  : Byte; {Indicates whether entry display also has status info}
      Soffset                  : Byte; {Offset into prompt of Select char (for highlight)}
      Prompt                   : ^String; {Points to string displayed for menu item}
      SubMenu                  : Menuptr; {Points to submenu if any}
    end;

  SubArray                 = array[1..MaxSelections] of SubMenuRecord;

  Menurecord =                    {12 bytes}
    record
      MenuLev                  : Byte; {Depth of this menu, points into MenuDescriptor array}
      XPosn                    : Byte; {X upper left. not border, but text position}
      YPosn                    : Byte; {Y upper left. not border, but text position}
      XSize                    : Byte; {Number of characters of text}
      YSize                    : Byte; {Number of lines of text}
      SubMax                   : Byte; {Number of selections or submenus}
      SubCur                   : Byte; {Currently active submenu or selection}
      SubOn                    : Boolean; {True if submenu is simultaneously displayed}
      SubMenus                 : ^SubArray; {Points to array of selections}
    end;

var
  MenuDesc                 : Menulevels; {General specification of each menu level}
  RootMenu                 : Menuptr; {The menu that starts it all}
  CurrMenu                 : Menuptr; {Currently active menu}
  ExitMenu                 : Boolean; {False to loop within menu system}
  MenuDataSize, MenuResult : Integer; {Menu data file size and array dimension, Result of initmenus}
  P                        : InitArrayPtr; {Pointer to menu data area}

  ScreenAttr               : MenuAttributeArray; {-Global to store colors passed to init routine}
  UserHelp                 : UserHelpType; {-User defined help routine when F1 is pressed}
  UserValidation           : UserValidationType; {-User defined routine to validate
                                          access to a menu item}
  UserExitMenus            : UserValidationType; {-Allow exit from the menu system}
  UserEvaluateSpecial      : UserEvaluateType; {-User defined routine to allow
                                            display of variables on menus}
  ToggleBoolean            : Integer; {-Allows pressing space or backspace to force a
                            boolean variable to ON or OFF, respectively.
                            0=no change,
                            1=force to OFF,
                            2=force to ON
                            Check it on return from the menu system and set
                            your variable accordingly}

procedure GetMenuChoice(var Cmd : Integer; var ExitMenu : Boolean);
  {-Display the menu system, and get a selection}

function InitMenus(MenuName : String; ColorTable : MenuAttributeArray;
                   UserDefinedHelpPtr,
                   UserDefinedValidationPtr,
                   UserdefinedEvaluatePtr,
                   UserDefinedExitMenusPtr,
                   BuiltInMenuAddress       : Pointer) : Integer;

procedure ToggleBooleanVal(var InBoolean : Boolean);
  {-A routine to force the state of a boolean variable based on the value of
    the global ToggleBoolean variable.  This allows you, for instance, to
    build keyboard macros that set the state of a boolean variable in the
    menu system without first knowing the variable's value.}
  {==========================================================================}

implementation

  procedure ToggleBooleanVal(var InBoolean : Boolean);
  {-A routine to force the state of a boolean variable based on the value of
    the global ToggleBoolean variable.  This allows you, for instance, to
    build keyboard macros that set the state of a boolean variable in the
    menu system without first knowing the variable's value.}

  begin
    case ToggleBoolean of
      2 : InBoolean := True;      {Force it to ON}
      1 : InBoolean := False;     {Force it to OFF}
    else
      InBoolean := not(InBoolean); {Otherwise, just toggle it}
    end;
    ToggleBoolean := 0;
  end;

  procedure DrawItem(Menu : Menuptr; sub : Byte);
    {-Draw menu item "sub" of the chosen menu}
  const
    {Flags used for status display in menu system}
    NoStat                   = 0; {Entry displays no status}
    BoolStat                 = 1; {Entry displays boolean - ON/OFF - status}
    NumStat                  = 2; {Entry displays numeric status}
    StrStat                  = 3; {Entry displays string status}
  var
    R, C, Len                : Byte;
    S                        : String;
    Orient                   : MenuOrientation;

  begin                           {DrawItem}

    {Get the orientation of the current menu}
    Orient := MenuDesc[Menu^.MenuLev].Orientation;

    with Menu^, SubMenus^[sub] do
    begin

      {Copy the prompt to a work string}
      Len := Ord(Prompt^[0]);
      R := YPosn;
      C := XPosn;

      {Pad with blanks left and right}
      if Orient = Vertical then
      begin
        S[0] := Chr(XSize);
        R := R+Doffset;
      end
      else
      begin
        S[0] := Chr(Len+2);
        C := C+Doffset;
      end;

      FillChar(S[1], Length(S), #32);
      Move(Prompt^[1], S[2], Len);

      if StatVal <> NoStat then
        {Special cases to display status items, etc}
        if @UserEvaluateSpecial <> nil then
          UserEvaluateSpecial(Command, StatVal, S);

      if (@UserValidation <> nil) then
      begin
        if (Menu^.SubCur <> sub) then
        begin
          if (UserValidation(Command)) then
          begin
            {Write item with highlighted selection character}
            FastWrite(Copy(S, 1, Soffset), R, C, ScreenAttr[TextColor]);
            FastWrite(S[Succ(Soffset)], R, C+Soffset, ScreenAttr[HighLightColor]);
            FastWrite(Copy(S, Soffset+2, Length(S)), R, Succ(C+Soffset), ScreenAttr[TextColor]);
          end
          else FastWrite(S, R, C, ScreenAttr[TextColor])
        end
        else
          {Write the selected prompt}
          FastWrite(S, R, C, ScreenAttr[SelectColor]);
      end
      else
      begin
        if Menu^.SubCur <> sub then
        begin
          {Write item with highlighted selection character}
          FastWrite(Copy(S, 1, Soffset), R, C, ScreenAttr[TextColor]);
          FastWrite(S[Succ(Soffset)], R, C+Soffset, ScreenAttr[HighLightColor]);
          FastWrite(Copy(S, Soffset+2, Length(S)), R, Succ(C+Soffset), ScreenAttr[TextColor]);
        end
        else
          {Write the selected prompt}
          FastWrite(S, R, C, ScreenAttr[SelectColor]);
      end;
    end;
  end;                            {DrawItem}

  procedure UndrawMenu(Menu : Menuptr);
    {-remove the menu and its children from the screen}

  begin                           {Undrawmenu}

    if Menu = nil then
      Exit;

    with Menu^ do
    begin
      {Undraw any submenus - must do first to get proper screen restore}
      if SubOn then
      begin
        UndrawMenu(SubMenus^[SubCur].SubMenu);
        SubOn := False;
      end;

      with MenuDesc[MenuLev] do
        {Restore whatever the menu overlapped on the screen}
        DisposeWindow(EraseTopWindow);
    end;
  end;                            {Undrawmenu}

  procedure EraseMenus;
    {-Remove the menu system from the screen}

  begin                           {EraseMenus}
    UndrawMenu(RootMenu);
    CurrMenu := nil;
    NormalCursor;
  end;                            {EraseMenus}

  procedure DrawMenu(Menu : Menuptr);
    {-Draw a menu and its selected children on the screen}
  var
    I                        : Byte;
    S                        : String;

  begin                           {DrawMenu}

    if Menu = nil then
      Exit;

    with Menu^ do
    begin

      with MenuDesc[MenuLev] do
      begin
        {Create a window to contain the menu}
        if MakeWindow(Overlap, Pred(XPosn), Pred(YPosn), XPosn+XSize, YPosn+YSize, True, True, True,
                      ScreenAttr[TextColor], ScreenAttr[FrameColor], ScreenAttr[FrameColor], '') then
          if DisplayWindow(Overlap) then ; {You may wish to put some error trapping here}
      end;

      {Draw each item in the menu}
      for I := 1 to SubMax do
        DrawItem(Menu, I);

      {Draw any submenus}
      if SubOn then
        DrawMenu(SubMenus^[SubCur].SubMenu);

    end;
  end;                            {Drawmenu}


  procedure GetMenuChoice(var Cmd : Integer; var ExitMenu : Boolean);
    {-Display the menu system, and get a selection}
  type
    {Available commands when menu selection is being made}
    MenuCommandType          = (Mup, Mdown, Mright, Mleft, Mesc, Msel, Mhelp, Mnul);
  var
    Ch                       : Char;
    Mcmd                     : MenuCommandType;
    Done                     : Boolean;
    sub                      : Byte;

    function MenuCommand(CurrMenu                 : Menuptr;
                         var Ch                   : Char;
                         var Mcmd                 : MenuCommandType) : Boolean;
      {-Return a menucommand or a character}
    type
      str1                     = String[1];
      str2                     = String[2];
    const
      WScommands               : String[6] = ^@^D^E^S^X^J;
      EXcommands               : String[5] = 'MHKP;';
    var
      Orient                   : MenuOrientation;
      Lev                      : Integer;
      nullstr                  : str1;
      pushstr                  : str2;
      PushWord                 : Word;

    begin                         {MenuCommand}
      nullstr := '';
      pushstr := '';
      MenuCommand := True;
      {Get the orientation of the current menu}
      Lev := CurrMenu^.MenuLev;
      Orient := MenuDesc[Lev].Orientation;
      Mcmd := Mnul;
      Ch := Readkey;
      if Ch = Null then           {possibly attempted to press a hot key}
      begin
        {Extended character, get other half and convert to WS format}
        Ch := Readkey;
        pushstr := Null+Ch;
        Ch := WScommands[Succ(Pos(Ch, EXcommands))];
      end;

      case Ch of
        ^J :                      {F1}
          Mcmd := Mhelp;
        ^E :                      {Up arrow}
          if Orient = Vertical then
            Mcmd := Mup;
        ^X :                      {Down arrow}
          if Lev = 1 then
            Mcmd := Msel
          else if Orient = Vertical then
            Mcmd := Mdown;
        ^S :                      {Left arrow}
          if Lev <= 2 then
            Mcmd := Mleft;
        ^D :                      {Right arrow}
          if Lev <= 2 then
            Mcmd := Mright;
        ^M :                      {Enter}
          Mcmd := Msel;
        #32 : if CurrMenu^.SubMenus^[CurrMenu^.SubCur].StatVal = 1 then {Space}
              begin
                ToggleBoolean := 2;
                Mcmd := Msel;
              end;
        ^H : if CurrMenu^.SubMenus^[CurrMenu^.SubCur].StatVal = 1 then {Backspace}
             begin
               ToggleBoolean := 1;
               Mcmd := Msel;
             end;
        ^[ :                      {Esc}
          Mcmd := Mesc;
      else
        {Probably not a menu command -- this code allows hooks to hot keys}

        {If a key which begins with a null, yet is not a valid menu command,
        is pressed, this routine exits the menu system and puts the key into
        the keyboard buffer to be processed by the calling routine}
        MenuCommand := False;
        {$IFDEF AllowHotKeys}
        begin
          if pushstr='' then MenuCommand := false
          else
          begin
            MenuCommand := true;
            Mcmd:=Mesc;     {Exit the menus}
            Move(PushStr[1],PushWord,2);
            StuffKey(pushword);
          end;
        end;
        {$ENDIF}
      end;
    end;                          {MenuCommand}

    function MenuSelection(CurrMenu : Menuptr; Ch : Char; var sub : Byte) : Boolean;
      {-Return true and a submenu number if ch matches a select character}
    var
      Found                    : Boolean;

    begin                         {MenuSelection}
      with CurrMenu^ do
      begin
        Ch := Upcase(Ch);
        sub := 1;
        Found := False;
        while not(Found) and (sub <= SubMax) do
        begin
          with SubMenus^[sub] do
            if @UserValidation <> nil then
            begin
              Found := (UserValidation(Command)) and
              (Upcase(Prompt^[Soffset]) = Ch);
            end
            else Found := (Upcase(Prompt^[Soffset]) = Ch);
          if not(Found) then
            Inc(sub);
        end;
      end;
      MenuSelection := Found;
    end;                          {MenuSelection}

    procedure UpdateItem(Menu : Menuptr; SubLast, SubCur : Byte);
      {-Highlight the current menu item}

    begin                         {UpdateItem}
      DrawItem(Menu, SubLast);
      DrawItem(Menu, SubCur);
    end;                          {UpdateItem}

    procedure DecCurSubmenu(Menu : Menuptr);
      {-Move to the previous selection, and wrap}
    var
      SubLast                  : Byte;

    begin                         {DecCurSubmenu}
      with Menu^ do
      begin
        SubLast := SubCur;
        if @UserValidation <> nil then
        begin
          repeat
            if SubCur > 1 then
              Dec(SubCur)
            else
              SubCur := SubMax;
          until UserValidation(SubMenus^[SubCur].Command);
        end
        else
        begin
          if SubCur > 1 then
            Dec(SubCur)
          else
            SubCur := SubMax;
        end;
        UpdateItem(Menu, SubLast, SubCur);
      end;
    end;                          {DecCurSubmenu}

    procedure IncCurSubmenu(Menu : Menuptr);
      {-Move to the next selection, and wrap}
    var
      SubLast                  : Byte;

    begin                         {IncCurSubmenu}
      with Menu^ do
      begin
        SubLast := SubCur;
        if @UserValidation <> nil then
        begin
          repeat
            if SubCur < SubMax then
              Inc(SubCur)
            else
              SubCur := 1;
          until UserValidation(SubMenus^[SubCur].Command);
        end
        else
        begin
          if SubCur < SubMax then
            Inc(SubCur)
          else
            SubCur := 1;
        end;
        UpdateItem(Menu, SubLast, SubCur);
      end;
    end;                          {IncCurSubmenu}

    procedure SetInitSelection(CurrMenu : Menuptr);
      {-Assure initial menu selection is accessible}

    begin                         {SetInitSelection}
      with CurrMenu^ do
      begin
        if SubCur < 1 then
          SubCur := 1;
        if @UserValidation <> nil then
        begin
          while not(UserValidation(SubMenus^[SubCur].Command)) do
            if SubCur < SubMax then
              Inc(SubCur)
            else
              SubCur := 1;
        end;
      end;
    end;                          {SetInitSelection}

    function EvaluateMenuCommand(var CurrMenu             : Menuptr;
                                 Mcmd                     : MenuCommandType;
                                 var Cmd                  : Integer) : Boolean;
      {-Change current selection and current menu as indicated}
    var
      Done                     : Boolean;
      Ch                       : Char;

    begin
      Done := False;

      case Mcmd of

        Mleft :
          begin
            {Move the root menu selection left}
            DecCurSubmenu(RootMenu);
            if CurrMenu <> RootMenu then
            begin
              UndrawMenu(CurrMenu);
              with RootMenu^ do
                CurrMenu := SubMenus^[SubCur].SubMenu;
              SetInitSelection(CurrMenu);
              DrawMenu(CurrMenu);
            end;
          end;

        Mright :
          begin
            {Move the root menu selection right}
            IncCurSubmenu(RootMenu);
            if CurrMenu <> RootMenu then
            begin
              UndrawMenu(CurrMenu);
              with RootMenu^ do
                CurrMenu := SubMenus^[SubCur].SubMenu;
              SetInitSelection(CurrMenu);
              DrawMenu(CurrMenu);
            end;
          end;

        Mup :
          {Move the current menu selection up}
          DecCurSubmenu(CurrMenu);

        Mdown :
          {Move the current menu selection down}
          IncCurSubmenu(CurrMenu);

        Mesc :
          if CurrMenu = RootMenu then
          begin
            {Leave the menu system}
            Done := True;
            EraseMenus;
            Cmd := 0;
          end
          else
          begin
            UndrawMenu(CurrMenu);
            if CurrMenu^.MenuLev = 2 then
              {Move back to the root menu}
              CurrMenu := RootMenu
            else
              with RootMenu^ do
                {Move back to level 2}
                CurrMenu := SubMenus^[SubCur].SubMenu;
            CurrMenu^.SubOn := False;
          end;

        Msel :
          with CurrMenu^ do
            if SubMenus^[SubCur].SubMenu <> nil then
            begin
              {Another menu below, display it and move to it}
              SubOn := True;
              CurrMenu := SubMenus^[SubCur].SubMenu;
              SetInitSelection(CurrMenu);
              DrawMenu(CurrMenu);
            end
            else
            begin
              {Bottom level menu, return a command}
              Done := True;
              Cmd := SubMenus^[SubCur].Command;
              if @UserExitMenus <> nil then
              begin
                if UserExitMenus(Cmd) then EraseMenus;
              end
              else EraseMenus;
            end;
        Mhelp : if @UserHelp <> nil then
                  with CurrMenu^ do UserHelp(SubMenus^[SubCur].Command);
      end;
      EvaluateMenuCommand := Done;
    end;                          {EvaluateMenuCommand}

    function EvaluateSelectionCommand(var CurrMenu             : Menuptr;
                                      sub                      : Byte;
                                      var Cmd                  : Integer) : Boolean;
      {-Select from the menu based on a prompt character}
    var
      Done                     : Boolean;
      SubLast                  : Byte;

    begin                         {EvaluateSelectionCommand}
      Done := False;
      with CurrMenu^ do
      begin
        SubLast := SubCur;
        if SubMenus^[sub].SubMenu <> nil then
        begin
          {Open up the selected submenu}
          SubCur := sub;
          SubOn := True;
          {Update the screen}
          UpdateItem(CurrMenu, SubLast, SubCur);
          CurrMenu := SubMenus^[SubCur].SubMenu;
          SetInitSelection(CurrMenu);
          DrawMenu(CurrMenu);
        end
        else
        begin
          {Accept the command}
          Done := True;
          SubCur := sub;
          {Update the screen}
          UpdateItem(CurrMenu, SubLast, SubCur);
          Cmd := SubMenus^[SubCur].Command;
          if @UserExitMenus <> nil then
          begin
            if UserExitMenus(Cmd) then EraseMenus;
          end
          else EraseMenus;
        end;
      end;
      EvaluateSelectionCommand := Done;
    end;                          {EvaluateSelectionCommand}

  begin                           {GetMenuChoice}
    HiddenCursor;
    ToggleBoolean := 0;
    if CurrMenu = nil then
      CurrMenu := RootMenu;

    {Set the initial menu selection to an acceptable one}
    SetInitSelection(CurrMenu);

    if CurrMenu = RootMenu then
      DrawMenu(CurrMenu)
    else
      {Menu already on screen, just update the items}
      for sub := 1 to CurrMenu^.SubMax do
        DrawItem(CurrMenu, sub);

    Done := False;

    repeat

      if MenuCommand(CurrMenu, Ch, Mcmd) then
        {Move the cursor, escape, or select the current submenu}
        Done := EvaluateMenuCommand(CurrMenu, Mcmd, Cmd)

      else if MenuSelection(CurrMenu, Ch, sub) then
        {Select an entry by letter}
        Done := EvaluateSelectionCommand(CurrMenu, sub, Cmd);

    until Done;

    ExitMenu := False;

  end;                            {GetMenuChoice}

  function InitMenus(MenuName : String; ColorTable : MenuAttributeArray;
                     UserDefinedHelpPtr,
                     UserDefinedValidationPtr,
                     UserdefinedEvaluatePtr,
                     UserDefinedExitMenusPtr,
                     BuiltInMenuAddress       : Pointer) : Integer;
    {-Set up the dynamic data structure of the menus}
  var
    br, InitPos, Smax, I     : Integer;
    Tmenu                    : Menuptr;
    cm                       : file;
    UserDefinedHelp          : UserHelpType absolute UserDefinedHelpPtr;
    UserDefinedValidation    : UserValidationType absolute UserDefinedValidationPtr;
    UserdefinedEvaluate      : UserEvaluateType absolute UserdefinedEvaluatePtr;
    UserDefinedExitMenus     : UserValidationType absolute UserDefinedExitMenusPtr;

    procedure InitMenuDesc(var MenuDesc : Menulevels);
      {-Initialize general descriptions of each level of menu}

    begin                         {Initmenudesc}
      with MenuDesc[1] do
      begin
        Orientation := Horizontal;
        Overlap := nil;
      end;
      with MenuDesc[2] do
      begin
        Orientation := Vertical;
        Overlap := nil;
      end;
      with MenuDesc[3] do
      begin
        Orientation := Vertical;
        Overlap := nil;
      end;
    end;                          {InitMenuDesc}

    function GetInitByte(P : InitArrayPtr; var InitPos : Integer) : Byte;
      {-Return the next byte from the menu initialization data}

    begin                         {GetInitByte}
      GetInitByte := P^[InitPos];
      Inc(InitPos);
    end;                          {GetInitByte}

    function InitMenu(P : InitArrayPtr; var InitPos, Smax : Integer; var Tmenu : Menuptr) : Integer;
      {-Initialize the parameters of one menu level}
    var
      Lev, Xp, Yp, Xs, Ys      : Byte;
      Smenu                    : Menuptr;

    begin                         {InitMenu}
      InitMenu := 0;              {-assume success}
      {Get the next six bytes from the initialization data}
      Lev := GetInitByte(P, InitPos);
      Xp := GetInitByte(P, InitPos);
      Yp := GetInitByte(P, InitPos);
      Xs := GetInitByte(P, InitPos);
      Ys := GetInitByte(P, InitPos);
      Smax := GetInitByte(P, InitPos);

      if Smax = 0 then
        {No items in this menu}
        Tmenu := nil
      else
      begin
        {Get the menu record and initialize it}
        if MemAvail >= SizeOf(Menuptr) then New(Tmenu)
        else
        begin
          InitMenu := -1;         {-Out of memory}
          Exit;
        end;
        with Tmenu^ do
        begin
          XPosn := Xp;
          YPosn := Yp;
          XSize := Xs;
          YSize := Ys;
          MenuLev := Lev;
          SubMax := Smax;
          SubCur := 0;
          SubOn := False;
          if MemAvail >= (SubMax*SizeOf(SubMenuRecord)) then
            GetMem(SubMenus, SubMax*SizeOf(SubMenuRecord))
          else
          begin
            InitMenu := -1;       {-Out of memory}
            Exit;
          end;
        end;
      end;

      case Lev of
        1 : RootMenu := Tmenu;

        2 : if RootMenu = nil then
            begin
              InitMenu := -2;     {-Root menu must be specified first}
              Exit;
            end
            else
              with RootMenu^ do
              begin
                Inc(SubCur);
                if SubCur > SubMax then
                begin
                  InitMenu := -3; {-Too many submenus specified}
                  Exit;
                end;
                SubMenus^[SubCur].SubMenu := Tmenu;
              end;

        3 : if RootMenu = nil then
            begin
              InitMenu := -2;     {-Root menu must be specified first}
              Exit;
            end
            else
              with RootMenu^ do
              begin
                Smenu := RootMenu^.SubMenus^[RootMenu^.SubCur].SubMenu;
                if Smenu = nil then
                begin
                  InitMenu := -2; {-Root menu must be specified first}
                  Exit;
                end
                else
                  with Smenu^ do
                  begin
                    Inc(SubCur);
                    if SubCur > SubMax then
                    begin
                      InitMenu := -3; {-Too many submenus specified}
                      Exit;
                    end;
                    SubMenus^[SubCur].SubMenu := Tmenu;
                  end;
              end;

      else
        begin
          InitMenu := -4;         {-Error in level number in menu data file}
          Exit;
        end;
      end;

    end;                          {InitMenu}

    procedure InitItem(P : InitArrayPtr; var InitPos : Integer;
                       var sub                  : SubMenuRecord);
      {-Initialize the parameters of one menu entry}
    var
      Scord, Cord, Dofs, Spec, Sofs : Byte;

    begin                         {Inititem}

      {Get the next four bytes from the initialization data}
      Scord := GetInitByte(P, InitPos);
      Cord := GetInitByte(P, InitPos);
      Dofs := GetInitByte(P, InitPos);
      Spec := GetInitByte(P, InitPos);
      Sofs := GetInitByte(P, InitPos);

      {Store the record}
      with sub do
      begin
        Soffset := Succ(Sofs);    {String index where selection char is}
        Doffset := Dofs;
        StatVal := Spec;
        Command := Cord+(Scord*256);
        {Assume no deeper submenus}
        SubMenu := nil;
        {Store pointer to string}
        Prompt := Ptr(Seg(P^), Ofs(P^)+Pred(InitPos));
        {Skip over string}
        InitPos := InitPos+Succ(P^[InitPos]);
      end;

    end;                          {Inititem}

    procedure TraverseMenus(Menu : Menuptr);
      {-Traverse the entire menu system, setting the current submenu to 1}
    var
      sub                      : Byte;
      S                        : Menuptr;

    begin                         {TraverseMenu}
      with Menu^ do
      begin
        SubCur := 1;
        for sub := 1 to SubMax do
        begin
          S := SubMenus^[sub].SubMenu;
          if S <> nil then
            {Recursive call to traverse the next level}
            TraverseMenus(S);
        end;
      end;
    end;                          {TraverseMenu}

  begin                           {InitMenus}
    {No root menu exists initially}
    InitMenus := 0;               {-Assume success}
    RootMenu := nil;

    {-Move passed parameters to globals we can keep around}
    ScreenAttr := ColorTable;
    UserHelp := UserDefinedHelp;
    UserValidation := UserDefinedValidation;
    UserEvaluateSpecial := UserdefinedEvaluate;
    UserExitMenus := UserDefinedExitMenus;
    {Initialize the menu descriptors for each menu level}
    InitMenuDesc(MenuDesc);

    {Initialize menu data}
    if MenuName <> '' then
    begin
      Assign(cm, MenuName);
      Reset(cm, 1);
      if IoResult <> 0 then
      begin
        P := nil;
        InitMenus := -5;          {-Error opening the file}
        Exit;
      end
      else
      begin
        MenuDataSize := FileSize(cm);
        GetMem(P, MenuDataSize);
        BlockRead(cm, P^[1], MenuDataSize, br);
        if IoResult <> 0 then
        begin
          InitMenus := -6;        {-Error reading the file}
          Close(cm);
          Exit;
        end;
        Close(cm);
      end;
    end
    else
    begin
      if BuiltInMenuAddress <> nil then P := BuiltInMenuAddress
      else InitMenus := -5;       {-Error opening the file}
    end;
    InitPos := 1;

    repeat
      {Initialize a menu group}
      MenuResult := InitMenu(P, InitPos, Smax, Tmenu);
      InitMenus := MenuResult;
      if MenuResult <> 0 then Exit;
      if Tmenu <> nil then
      begin
        {Initialize the entries for the menu group}
        for I := 1 to Smax do
          InitItem(P, InitPos, Tmenu^.SubMenus^[I]);
      end;
    until P^[InitPos] = $FF;

    {Set initial selections}
    TraverseMenus(RootMenu);

    {No menu is currently displayed}
    CurrMenu := nil;
    ExitMenu := True;

  end;                            {InitMenus}

end.